home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / freetype.zip / codetv.pas next >
Pascal/Delphi Source File  |  1996-08-30  |  5KB  |  218 lines
  1. {****************************************************************************}
  2. {*                                                                          *}
  3. {*  CodeView.PAS                                                            *}
  4. {*                                                                          *}
  5. {*  This unit implements a simple TrueType bytecode viewer for the          *}
  6. {*  FREETYPE project debugger.                                              *}
  7. {*                                                                          *}
  8. {****************************************************************************}
  9.  
  10. Unit CodeTV;
  11.  
  12. interface
  13.  
  14. uses Objects, Views, Drivers, TTTypes, TTDebug;
  15.  
  16. {$I DEBUGGER.INC}
  17.  
  18. type
  19.  
  20.   { TCodeViewer }
  21.  
  22.   { This TView is a simple code list viewer ( IP + focused + breaks ) }
  23.  
  24.   PCodeViewer = ^TCodeViewer;
  25.   TCodeViewer = object( TListViewer )
  26.  
  27.                   constructor Init( var Bounds : TRect );
  28.                   procedure Draw; virtual;
  29.                   procedure HandleEvent( var Event : TEvent  ); virtual;
  30.  
  31.                   procedure Set_Range( var ARange : TRangeRec );
  32.                   procedure Set_IP   ( AIP : Int );
  33.  
  34.                 private
  35.                   CodeRange : TRangeRec;
  36.                   IP        : Int;
  37.                 end;
  38.  
  39.   { TCodeWindow }
  40.  
  41.   PCodeWindow = ^TCodeWindow;
  42.   TCodeWindow = object( TWindow )
  43.                   CodeView : PCodeViewer;
  44.                   constructor Init( var Bounds : TRect );
  45.                 end;
  46.  
  47. implementation
  48.  
  49. { TCodeViewer }
  50.  
  51. constructor TCodeViewer.Init;
  52. begin
  53.   inherited Init( Bounds, 1, nil, nil );
  54.   SetRange(0);
  55.  
  56.   GrowMode  := gfGrowHiX or gfGrowHiY;
  57.   DragMode  := dmDragGrow or dmLimitLoX or dmLimitLoY;
  58.   EventMask := EventMask or evCommand;
  59.  
  60.   with CodeRange do
  61.   begin
  62.     Disassembled := nil;
  63.     NLines       := 0;
  64.   end;
  65.  
  66.   IP := -1;
  67. end;
  68.  
  69.  
  70. procedure TCodeViewer.HandleEvent( var Event : TEvent );
  71. var
  72.   Limits     : TRect;
  73.   Mini, Maxi : Objects.TPoint;
  74. begin
  75.  
  76.   if Event.What = evKeydown then
  77.  
  78.     case Event.KeyCode of
  79.  
  80.       kb_val_ToggleBreak : begin
  81.                              Event.What    := evCommand;
  82.                              Event.Command := cmToggleBreak;
  83.                            end;
  84.     end;
  85.  
  86.   inherited HandleEvent(Event);
  87.  
  88.   if (Event.What = evCommand) then
  89.  
  90.     case Event.Command of
  91.  
  92.       cmResize: begin
  93.                   Owner^.GetExtent(Limits);
  94.                   SizeLimits( Mini, Maxi );
  95.                   DragView(Event, DragMode, Limits, Mini, Maxi );
  96.                   ClearEvent(Event);
  97.                 end;
  98.  
  99.       cmToggleBreak: if State and sfSelected <> 0 then
  100.                      begin
  101.                        Toggle_Break( CodeRange,
  102.                                      CodeRange.Disassembled^[Focused] );
  103.                        DrawView;
  104.                      end;
  105.     end;
  106. end;
  107.  
  108.  
  109. procedure TCodeViewer.Draw;
  110. const
  111.   Colors : array[0..3] of byte
  112.          = ($1E,$40,$0E,$30);
  113. var
  114.   I, J, Item : Int;
  115.   B          : TDrawBuffer;
  116.   S          : String;
  117.   Indent     : Int;
  118.   Ligne      : Int;
  119.  
  120.   Color  : word;
  121.  
  122.   On_BP : boolean;
  123.   BP    : PBreakPoint;
  124.  
  125. begin
  126.  
  127. {
  128.   Colors[0] := GetColor(1);  (* Normal line *)
  129.   Colors[1] := GetColor(2);  (* Normal breakpoint *)
  130.   Colors[2] := GetColor(3);  (* Focused line *)
  131.   Colors[3] := GetColor(4);  (* Focused breakpoint *)
  132. }
  133.   if HScrollBar <> nil then Indent := HScrollBar^.Value else Indent := 0;
  134.  
  135.   BP := CodeRange.Breaks;
  136.  
  137.   with CodeRange do
  138.   begin
  139.  
  140.     if (BP<>nil) and (NLines>TopItem) then
  141.       while ( BP<>nil ) and ( BP^.Adresse < Disassembled^[TopItem] ) do
  142.         BP := BP^.Next;
  143.  
  144.     for I := 0 to Self.Size.Y-1 do
  145.     begin
  146.  
  147.       Item := TopItem + I;
  148.  
  149.       Color := 0;
  150.  
  151.       if Item < NLines then
  152.         begin
  153.  
  154.           Ligne := Disassembled^[Item];
  155.  
  156.           if ( BP<>nil ) and ( BP^.Adresse = Ligne ) then
  157.             begin
  158.               Color := 1;
  159.               Repeat
  160.                 BP := BP^.Next
  161.               until ( BP=nil ) or ( BP^.Adresse > Ligne );
  162.             end;
  163.  
  164.           if (Range > 0) and
  165.              (State and (sfSelected+sfActive) = (sfSelected+sfActive)) and
  166.              (Focused = Item ) then
  167.  
  168.             Color := Color or 2;
  169.  
  170.           S := ' ' + Cur_U_Line( Code, Ligne );
  171.           S := copy( S, 1 + Indent, Self.Size.X );
  172.  
  173.           if Ligne = IP then S[1] := '>';
  174.         end
  175.       else
  176.         begin
  177.           S := '';
  178.         end;
  179.  
  180.       Color := Colors[Color];
  181.  
  182.       MoveChar( B, ' ', Color, Self.Size.X );
  183.       MoveStr( B, S, Color );
  184.  
  185.       WriteLine( 0, I, Self.Size.X, 1, B );
  186.     end;
  187.   end;
  188. end;
  189.  
  190.  
  191. procedure TCodeViewer.Set_Range;
  192. begin
  193.   CodeRange := ARange;
  194.   SetRange( CodeRange.NLines );
  195.   FocusItem(0);
  196.   DrawView;
  197. end;
  198.  
  199.  
  200. procedure TCodeViewer.Set_IP;
  201. begin
  202.   IP := AIP;
  203.   DrawView;
  204. end;
  205.  
  206. { TCodeWindow }
  207.  
  208. constructor TCodeWindow.Init;
  209. begin
  210.   inherited Init( Bounds,'Code',wnNoNumber );
  211.   GetClipRect( Bounds );
  212.   Bounds.Grow(-1,-1);
  213.   New( CodeView, Init( Bounds ) );
  214.   Insert( CodeView );
  215. end;
  216.  
  217. end.
  218.